perm filename PARMOD[1,JRA] blob
sn#005836 filedate 1972-10-20 generic text, type T, neo UTF8
(DEFPROP PARMOD1
(LAMBDA(C D)
(PROG (YC YD Z Z1 Z2 X Y Y1 Y2 PAR TS)
(COND ((EQ C D) (RETURN NIL)))
(SETQ YC (CDR C))
PAR1 (SETQ YD (CDR D))
(SETQ X (CAR YC))
(COND ((NEG X) (RETURN PAR))
((ORDERP (CAR X) EQUAL) (GO PAR2))
((NOT (EQ (CAR X) EQUAL)) (RETURN PAR)))
PAR3 PAR3A
(COND ((NEG (CAR YD)) (SETQ Z2 (CDAR YD))) (T (SETQ Z2 (CAR YD))))
(SETQ Y1 (CDR X))
(COND ((VAR (CAR Y1)) (GO PAR7A)))
(SETQ Y2 (CADR Y1))
(SETQ Z (TERMS (CAAR Y1) (CDR Z2) PDEPTH))
(COND ((NULL Z) (GO PAR7A)))
PAR5 (SETQ Z1 Z)
PAR4 (SETQ Y (UNIFY (LIST (CAR Y1)) (LIST (CAAR Z1))))
(COND (Y (GO PAR6)))
PAR7 (SETQ Z1 (CDR Z1))
(COND (Z1 (GO PAR4)))
PAR7A
(SETQ YD (CDR YD))
(COND (YD (GO PAR3A)))
PAR2 (SETQ YC (CDR YC))
(COND (YC (GO PAR1)))
(RETURN PAR)
PAR6 (SETQ TS (CADR (SUBS3T* (CDR Y) (LIST NIL Y2))))
PAR9 (SETQ PARRES (SUBS3TA (CDR Y) Z2 (CAR Z1) TS))
(COND ((NEG (CAR YD)) (SETQ PARRES (CONS ESCAPE PARRES))))
(SETQ Y (UNION (CDR Y) C D X (CAR YD)))
(COND ((NULL Y) (GO PAR7)))
(SETQ PAR (CONS (SET2 (CAR (COND (DLIST (DEMOD Y DLIST)) (T Y))) TBL) PAR))
(GO PAR7)))
EXPR)